perm filename SOLNS1.F74[206,LSP] blob
sn#135143 filedate 1974-12-05 generic text, type T, neo UTF8
(DEFPROP HS
(NIL ALT
ODDS
ODDS1
ENTER
COMMONTAIL
COMMONR
RCYCLE
LCYCLE
PERMUT
PERMUT1
PERMUT2
REV1
CONN
COMP
MERGCOMPS
MERGCOMP
UNION)
VALUE)
(DEFPROP ALT
(LAMBDA (U M N) (COND ((NULL U) NIL) ((EQ M 1) (CONS (CAR U) (ALT (CDR U) N N))) (T (ALT (CDR U) (SUB1 M) N))))
EXPR)
(DEFPROP ODDS
(LAMBDA (U) (ODDS1 U NIL))
EXPR)
(DEFPROP ODDS1
(LAMBDA (U V) (COND ((NULL U) V) (T (ODDS1 (CDR U) (ENTER (CAR U) V)))))
EXPR)
(DEFPROP ENTER
(LAMBDA (X V) (COND ((NULL V) (LIST X)) ((EQUAL (CAR V) X) (CDR V)) (T (CONS (CAR V) (ENTER X (CDR V))))))
EXPR)
(DEFPROP COMMONTAIL
(LAMBDA (U V) (COMMONR (REVERSE U) (REVERSE V) NIL))
EXPR)
(DEFPROP COMMONR
(LAMBDA(U V W)
(COND ((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) W)
(T (COMMONR (CDR U) (CDR V) (CONS (CAR U) W)))))
EXPR)
(DEFPROP RCYCLE
(LAMBDA (U) ((LAMBDA (V) (CONS (CAR V) (REVERSE (CDR V)))) (REVERSE U)))
EXPR)
(DEFPROP LCYCLE
(LAMBDA (U) (APPEND (CDR U) (LIST (CAR U))))
EXPR)
(DEFPROP PERMUT
(LAMBDA (U) (COND ((NULL U) (QUOTE (NIL))) (T (PERMUT1 (CAR U) (PERMUT (CDR U))))))
EXPR)
(DEFPROP PERMUT1
(LAMBDA (X W) (COND ((NULL W) NIL) (T (APPEND (PERMUT2 NIL X (CAR W)) (PERMUT1 X (CDR W))))))
EXPR)
(DEFPROP PERMUT2
(LAMBDA(U X V)
(COND ((NULL V) (LIST (REVERSE (CONS X U))))
(T (CONS (REV1 (CONS X U) V) (PERMUT2 (CONS (CAR V) U) X (CDR V))))))
EXPR)
(DEFPROP REV1
(LAMBDA (U V) (COND ((NULL U) V) (T (REV1 (CDR U) (CONS (CAR U) V)))))
EXPR)
(DEFPROP CONN
(LAMBDA (U) (LESSP (COMP U) 2))
EXPR)
(DEFPROP COMP
(LAMBDA (U) (LENGTH (MERGCOMPS U)))
EXPR)
(DEFPROP MERGCOMPS
(LAMBDA (U) (COND ((NULL U) NIL) (T (MERGCOMP (CAAR U) (CAR U) (MERGCOMPS (CDR U))))))
EXPR)
(DEFPROP MERGCOMP
(LAMBDA(X C L)
(COND ((NULL L) (LIST C))
((MEMBER X (CAR L)) (MERGCOMP X (UNION C (CAR L)) (CDR L)))
(T (CONS (CAR L) (MERGCOMP X C (CDR L))))))
EXPR)
(DEFPROP UNION
(LAMBDA (U V) (COND ((NULL U) V) ((MEMBER (CAR U) V) (UNION (CDR U) V)) (T (CONS (CAR U) (UNION (CDR U) V)))))
EXPR)